
	CHARACTER*1 MRK(8)
	CHARACTER*2 IY,PC(5),PCD(50),PCE(50),PND(8),TT
	CHARACTER*3 P1(50),P2(50),MON(12)
	CHARACTER*4 CBTT(50),CBTK(50),CBB(50),CBT(50),IYT
	CHARACTER*6 N
	CHARACTER*7 P
	CHARACTER*8 U,F,ANS
	CHARACTER*10 S,ADD,C
	CHARACTER*11 MONT(12),MONTH
	CHARACTER*12 MARK
	CHARACTER*20 FT(50),TIT(50)
	CHARACTER*27 AP
C
	DIMENSION FN(50),FH(50),IFN(50),IFH(50),IFL(50),AVE(50),AV(12)
	DIMENSION MN(12),DATA(12),FL(50),FP(50),IAVE(50),IPN(50)
	DIMENSION IPH(50),IPL(50)
C
C
	INCLUDE 'DRA2:[MPOLL]OPEN4.DAT/LIST'
	INCLUDE 'SYS$LIBRARY:FORIOSDEF/LIST'
C
C
	DATA MON/'OCT','NOV','DEC','JAN','FEB','MAR','APR','MAY',
	1	 'JUN','JUL','AUG','SEP'/
	DATA MONT/'OCTOBER 1  ','NOVEMBER 1 ','DECEMBER 1 ','JANUARY 1  ',
	1	  'FEBRUARY 1 ','MARCH 1    ','APRIL 1    ','MAY 1      ',
	1	  'JUNE 1     ','JULY 1     ','AUGUST 1   ','SEPTEMBER 1'/
	DATA MN/1,2,3,4,5,6,7,8,9,10,11,12/
	DATA PC/'55','39','40','53','55'/
	DATA PND/'60','61','62','63','64','65','66','67'/
	DATA MRK/'E','Y','Y','E','A','E','Y','S'/
C
C
	U='(1000AF)'
	F='FORECAST'
	N='NORMAL'
	S='SUBSEQUENT'
	C='CONDITIONS'
	P='PERCENT'
	AP='ABCDEFGHIJKLMNOPQRSTUVWXYZ '
	MARK='            '
C
C
1006	FORMAT(2H :,A,4X,A,'-',A,5X,F6.1,5X,F6.1,4X,I4,4X,F6.1,
	1	5X,I4,5X,F6.1,5X,I4,2X,2H :)
1007	FORMAT(2H :,103X,1H:,/,2H :,103(1H_),1H:)
1005	FORMAT(45X,'MONTHLY FORECAST SUMMARY'/,48X,A,'  ',A,/,2H :,
	1	103(1H-),1H:/,2H :,23X,1H:,10X,1H:,11X,1H:,5X,A,7X,
	1	1H:,3X,'150% ',A,5X,1H:,3X,'50% ',A,4X,1H:,/
	1	2H :,23X,1H:,10X,1H:,11X,1H:,3X,A,5X,1H:,3X,A,6X,1H:,
	1	3X,A,4X,1H:/,2H :,23X,1H:,10X,1H:,11X,':',
	1	3X,A,5X,1H:,3X,A,6X,1H:,3X,A,4X,1H:,/,
	1	2H :,23X,1H:,10X,1H:,'1961-1980','  :',18X,1H:,19X,1H:,
	1	17X,1H:/,
	1	2H :,23X,1H:,A,'  : AVERAGE   :',A,2X,A,' :',A,2X,A,
	1	'  :',A,2X,A,':'/2H :,A,15X,':PERIOD    : ',A,'  :',A,
	1	2X,A,'  :',A,2X,A,3X,1H:,A,2X,A,' :'/,2H :,103(1H-),1H:,
	1	/,2H :,103X,1H:/2H :,39X,'AVE',7X,'NORM',6X,'%',7X,
	1	'HIGH',7X,'%',9X,'LOW',8X,'%',3X,1H:/,2H :,103X,1H:)
1010	FORMAT(' ERROR IN READ UNIT=1, IOS=',I2,/,A12,6F11.2/12X,F11.2)
1008	FORMAT(' ATTEMPT TO ACCESS NON-EXISTENT RECORD IOS=',I2,1X,A)
1011	FORMAT(' ERROR ON REWRITE IOS=',I2,A12,6F11.2/12X,6F11.2)
1013	FORMAT(' ERROR ON OPEN UNIT=1, IOS=',I2)
1012	FORMAT(' ERROR ON WRITE TO INDEX FILE IOS=',I2,A12,6F11.2/12X,
	16F11.2)
1014	FORMAT(' ERROR ON CLOSE, IOS=',I2,',UNIT=1')
C
C
	I=1
101	READ(2,1000,END=100)TIT(I),CBT(I),PCD(I),CBB(I)
1000	FORMAT(A,1X,A,8X,A,1X,A)
	I=I+1
	GO TO 101
100	K=1
103	READ(3,1001,END=102)P1(K),P2(K),FT(K),FN(K),FH(K),FL(K),FP(K)
1001	FORMAT(1X,2A,2X,A,10X,4F9.1)
	K=K+1
	GO TO 103
102	NF=K-1
C
C
	DO 304 J=1,12
	IF(P1(1).EQ.MON(J))THEN
		MONTH=MONT(J)
		MNT=MN(J)
		END IF
304	CONTINUE
	NT=I-1
C
C
	CALL IDATE(IMO,IDA,IYR)
C	IYR=82
	ENCODE(2,1002,IY)IYR
1002	FORMAT(I2)
	IYT='19'//IY
	DO 300 K=1,NF
	DO 301 I=1,NT
	IF(FT(K).EQ.TIT(I))THEN
		CBTT(K)=CBT(I)
		CBTK(K)=CBB(I)
		PCE(K)=PCD(I)
		END IF
301	CONTINUE
	ADD=CBTK(K)//'55'//'9999'
3000	READ(UNIT=1,KEY=ADD,KEYID=0,IOSTAT=IOS,ERR=2000)ADD,AV
	AVE(K)=AV(MNT)
	IPN(K)=(FN(K)/AVE(K)+.005)*100.
	IPH(K)=(FH(K)/AVE(K)+.005)*100.
	IPL(K)=(FL(K)/AVE(K)+.005)*100.
	IFN(K)=FN(K)+.5
	IFH(K)=FH(K)+.5
	IFL(K)=FL(K)+.5
	IAVE(K)=AVE(K)+.5
	GO TO 300
2000	IF(IOS.EQ.52)CALL RECLOCK(*3000,*5000)
	IF(IOS.EQ.36)THEN
		WRITE(6,1008)IOS,ADD
		DO 306 KK=1,12
		AV(KK)=998877.
306		CONTINUE
		END IF
	IAVE(K)=AVE(K)+.5	
300	CONTINUE
	WRITE(7,1005)MONTH,IYT,N,N,N,S,S,S,C,C,C,F,F,P,F,P,F,P,F,U,
	1	     U,N,U,N,U,N
 	DO 305 K=1,NF
	WRITE(7,1006)FT(K),P1(K),P2(K),AVE(K),FN(K),IPN(K),
	1	     FH(K),IPH(K),FL(K),IPL(K)
305	CONTINUE
	WRITE(7,1007)
	WRITE(6,1016)
1016	FORMAT(' WRITE FORECASTS TO MPOLL FILE>'$)
	READ(5,1015)ANS
1015	FORMAT(A)
	IF(ANS.NE.'YES I DO')THEN
		WRITE(6,1017)
1017		FORMAT(' FORECASTS NOT WRITTEN TO MPOLL FILE')
		GO TO 5000
		END IF
C
C	WRITE FORECASTS TO INDEX FILE
C**********************************************************************
	DO 307 K=1,NF
	DO 308 JN=1,5
	IF(JN.EQ.5)PC(JN)=PCE(K)
	ADD=CBTT(K)//PC(JN)//IYT
	DO 309 J=1,12
	DATA(J)=998877.
	MARK(J:J)=' '
309	CONTINUE
3010	READ(UNIT=1,KEY=ADD,KEYID=0,IOSTAT=IOS,ERR=8000)ADD,DATA,MARK
	IF(IOS.EQ.0)THEN
	DO 317 KI=1,12
	TT='NO'
	DO 316 JI=1,27
	IF(MARK(KI:KI).EQ.AP(JI:JI))TT='OK'
316	CONTINUE
	IF(TT.EQ.'NO')MARK(KI:KI)=' '
317	CONTINUE
	MARK(MNT:MNT)='T'
	IF(PC(JN).EQ.PCE(K))THEN
		DATA(MNT)=FP(K)
		GO TO 312
		END IF
	IF(PC(JN).EQ.'55')DATA(MNT)=FN(K)
	IF(PC(JN).EQ.'39')DATA(MNT)=FH(K)
	IF(PC(JN).EQ.'40')DATA(MNT)=FL(K)
	IF(PC(JN).EQ.'53')DATA(MNT)=FP(K)
	DO 311 J=1,7
	IF(PCE(K).EQ.PND(J))THEN
		MARK(MNT:MNT)=MRK(J)
		DO 315 JI=1,12
		IF(MARK(JI:JI).EQ.'H')MARK(JI:JI)=MRK(J)
315		CONTINUE
		END IF
311	CONTINUE
312		REWRITE(UNIT=1,IOSTAT=IOS,ERR=8001)ADD,DATA,MARK
		UNLOCK 1
		END IF
	GO TO 308
8000	IF(IOS.EQ.52)CALL RECLOCK(*3010,*5000)
	IF(IOS.EQ.36)THEN	
		MARK(MNT:MNT)='T'
		IF(PC(JN).EQ.PCE(K))THEN
			DATA(MNT)=FP(K)
			GO TO 313
			END IF
		IF(PC(JN).EQ.'55')DATA(MNT)=FN(K)
		IF(PC(JN).EQ.'39')DATA(MNT)=FH(K)
		IF(PC(JN).EQ.'40')DATA(MNT)=FL(K)
		IF(PC(JN).EQ.'53')DATA(MNT)=FP(K)
		DO 314 J=1,7
		IF(PCE(K).EQ.PND(J))MARK(MNT:MNT)=MRK(J)
314		CONTINUE
313		WRITE(UNIT=1,IOSTAT=IOS,ERR=5001)ADD,DATA,MARK
		UNLOCK 1
		GO TO 308
		END IF
	WRITE(6,1010)IOS,ADD,DATA
	GO TO 5000
308	CONTINUE
307	CONTINUE
C
C
C	END OF WRITE TO INDEX FILE
C***********************************************************************
C
	WRITE(6,1018)
1018	FORMAT(' MPOLL UPDATED!!!!!!')
	GO TO 5000
8001	WRITE(6,1012)IOS,ADD,DATA
	GO TO 5000
5001	WRITE(6,1012)IOS,ADD,DATA
	GO TO 5000
9999	WRITE(6,1013)IOS
	GO TO 5003
5000	CLOSE(UNIT=1,ERR=5002,IOSTAT=IOS)
	GO TO 5003
5002	WRITE(6,1014)IOS
	GO TO 5003
5003	STOP
	END

